#!/usr/bin/perl
use Data::Dumper;
use strict;

$::trace = 0;
sub trace {
if ($::trace) { print ">";print @_;}}

{ my $uid = 1;
sub UID { return $uid++;}}

sub add_proto {
my $name = shift;
$::Proto->{$name} = new $name;}

sub send {
 my $from = shift;
 my $obj = shift;
 my $meth = shift;
 $meth =~ s/:/_COLON_/g;
 &::trace( "Calling method $meth with args: ", @_, "\n");
 #foreach my $o ( @_)
  #{ unless ($o->{PROXY}) { die "arg $o is not an object\n"}}
 my $ret = eval {$obj->{realobject}->$meth(@_);};
 if ($@){
  &::trace( $@);
  &::trace("Calling vtable func $meth instead\n");
  #print Dumper($obj->{realobject});
  #print Dumper($obj);
  print $@;
  $ret = eval {$obj->{realobject}->{vtable}->{$meth}->(@_);} ;
  if ($@){ die "Could not send $meth to ".$obj->{realobject}." because: $@\n";}
 }
 return $ret;
}

$::Proto = {};
add_proto($_) foreach ( qw'String Array Number Current Web AnonBlock True False While Object');
print Dumper ($::Proto);
my $c = new Neo;
$c->become( "START");
my @data = <STDIN>;
my $data = join("", @data);
my @letters = split(//, $data);
$c->input(\@letters);
my $last = $c->eatArray();
$last->become( "END");
#print Dumper $last;
&::trace(print "First pass done, file read\n");
foreach (1..5) { $c->run; $last->runback; }
&::trace(print "second pass done\n");
$c = $c->evolve;
$c=$c->findfirst;
foreach (1..15) { $c->run; }
&::trace(print "third pass done\n");

#$c->dump;
my $nodes = $c->makenodes;
$nodes = $nodes->findfirst;
$nodes->run foreach (1..15);
&::trace(print "fourth pass done\n");
$nodes->dump();
#$nodes->emit();
$nodes->exe({});
#print Dumper($nodes);
exit;

package String;
package True;
package False;
package Proxy;

sub new {
my $class = shift;
my $o = bless ({}, $class);
$o->{PROXY} = 1;
return $o;
}



package Primitive;
use Data::Dumper;
use Storable qw'dclone';


sub new {
my $class = shift;
my $o = bless ({}, $class);
$o->setvalue([]);
$o->{ID} = &::UID();
my $p = new Proxy;
$p->{ID} = $o->{ID};
$p->{realobject} = $o;
return $p;
}



sub clone {
my $s = shift;
my $o =  dclone($s);
$o->{ID} = &::UID();
my $p = new Proxy;
$p->{ID} = $o->{ID};
$p->{realobject} = $o;
return $p;
}

sub setprop {
my ($s, $propname, $val) = @_;
$s->{properties}->{$propname}= $val;
return $s;}

sub getprop {
my ($s, $propname) = @_;
$s->{properties}->{$propname};
}

sub makeprop_COLON_ {
my ($s, $propname) = @_;
my $pname = $propname->{realobject}->value;
my $propset = $pname."_COLON_";
$s->{vtable}->{$pname} = sub { return $s->getprop($pname)};
$s->{vtable}->{$pname."_COLON_"} = sub { return $s->setprop($pname, shift)};
#print Dumper($s->{vtable});
return $s;}

sub isObject { 1;}
sub equal_COLON_ {
my $s = shift;
my $arg = shift;
if ( $arg->{realobject}->value eq $s->value )
  { return new True; }
else
  { return new False; }
}
sub notEqual_COLON_ {
my $s = shift;
my $arg = shift;
if ( $arg->value eq $s->value )
  { return new True; }
else
  { return new False; }
}

sub println {
my $s = shift;
print $s->value;
print "\n";
}

sub print {
my $s = shift;
print $s->value;
}
sub value {
my $s = shift;
return $s->{value}}

sub setvalue {
my $s = shift;
my $val = shift;
$s->{value} = $val;
}

sub asString {
my $s = shift;
return $s->{value};}

sub asNumber {
my $s = shift;
return $s->{value};}

package While;
use base 'Primitive';
sub test_COLON_do_COLON_ {
print "Running loop\n";
  my $s = shift;
  my $test = shift;
  my $action = shift;
  my $ret = $test->exec;
print "Ran test\n";
use Data::Dumper;
  print Dumper($ret);
  if (ref($ret) =~/True/)
   {$action->exec; $s->test_COLON_do_COLON_($test, $action)}
}

package Object;
use base 'Primitive';


package False;
use base 'Primitive';

sub ifTrue_COLON_ {}
sub ifFalse_COLON_ {
  my $s = shift;
  my $arg = shift;
  &::send($s, $arg, 'exec');}  

sub ifTrue_COLON_ifFalse_COLON_ {
  my $s = shift;
  my $arg = shift;
  my $argf = shift;
  &::send($s, $argf, 'exec');}  

package True;
use base 'Primitive';

sub ifFalse_COLON_ {}
sub ifTrue_COLON_ {
  my $s = shift;
  my $arg = shift;
  &::send($s, $arg, 'exec');}  

sub ifTrue_COLON_ifFalse_COLON_ {
  my $s = shift;
  my $arg = shift;
  &::send($s, $arg, 'exec');}  



package AnonBlock;
use base 'Primitive';

sub new {
my $class = shift;
my $val = shift;
my $context = shift;
my $self  = $class->SUPER::new();
bless ($self->{realobject}, $class);
#print "Setting anonval to >".$val."<\n";
$self->{realobject}->setvalue($val);
$self->{realobject}->{context}=$context;
return $self;
}

sub exec {
my $s = shift;
&::trace( "Execing anonblock\n");
#$s->{context}->{execnow} = 1;
my $ret;
$s->{context}->{execnow} = 1;
return $s->value->exe($s->{context});}


package Web;
use base 'Primitive';

sub get_COLON_ {
my $s = shift;
my $arg = shift;
my $url = $arg->value;
my $ret =  `wget -O- $url`;
my $s = new String($ret);
return $s;}


package Current;
use base 'Primitive';

sub object_COLON_ {
my $s = shift;
my $arg = shift;
$s->{current_object} = $arg;}

sub object {
my $s = shift;
return $s->{current_object} }

package Array;
use base 'Primitive';


sub at_COLON_ {
my $s = shift;
my $arg = shift;
#print Dumper($arg);
return $s->value->[$arg->asNumber];
}

sub at_COLON_put_COLON_ {
my $s = shift;
my $arg = shift;
my $val = shift;
return $s->value->[$arg->asNumber] = $val;
}

package Number;
use base 'Primitive';
sub new {
my $class = shift;
my $val = shift;
my $self  = $class->SUPER::new();
bless ($self->{realobject}, $class);
#print "Setting numberval to >".$val."<\n";
$self->{realobject}->setvalue($val);
return $self;
}



sub add_COLON_ {
my $s = shift;
my $arg = shift;
my $n = new Number($s->value + $arg->{realobject}->value);
$n;}

sub subtract_COLON_ {
my $s = shift;
my $arg = shift;
my $n = new Number($s->value - $arg->{realobject}->value);
$n;}

sub multiply_COLON_ {
my $s = shift;
my $arg = shift;
my $n = new Number($s->value * $arg->{realobject}->value);
$n;}

sub divide_COLON_ {
my $s = shift;
my $arg = shift;
my $n = new Number($s->value * $arg->{realobject}->value);
$n;}

package String;
use Storable qw'dclone';
use base 'Primitive';

sub new {
my $class = shift;
my $val = shift;
my $self  = $class->SUPER::new();
bless ($self->{realobject}, $class);
#print "Setting stringval to >".$val."<\n";
$self->{realobject}->setvalue($val);
return $self;
}



sub value {
my $s = shift;
my $str =  $s->{value} ;
chop $str;
return $str;}

sub concat_COLON_ {
my $s = shift;
my $arg = shift;
$s->setvalue($s->value . $arg->{realobject}->value);
$s;}




package Neo;
package LinkList;

{
my $num = 0;
sub sequence {
return $num++;}
}

sub hashdump {
my $s = shift;
foreach my $k ( keys %{$s} )
 { print "$k: ".$s->{$k}."\n";}
print "--\n";}
sub pheno {
my ($s) = @_;
return $s->{pheno}}

sub become {
my ($s, $new) = @_;
$s->{subtype} ||= $s->{pheno};
$s->{pheno} = $new;
}

sub is {
my ($s, $q) = @_;
if ($q) { if ($q eq $s->pheno) {return 1} else {return 0}}
return $s->pheno;}

sub isprev {
my ($s, $q) = @_;
return $s->prev->is($q);}
sub isnext {
my ($s, $q) = @_;
return $s->next->is($q);}

sub next {
my ($s, $val) = @_;
if ($val) { $s->{next} = $val;}
return $s->{next};
}
sub prev {
my ($s, $val) = @_;
if ($val) { $s->{prev} = $val;}
return $s->{prev};
}
sub findfirst {
my ($s) = @_;
if ($s->prev){
return $s->prev->findfirst;}
else
{return $s}}

sub run{
my ($s) = @_;
$s->doStuff();
return unless $s->next();
$s->next()->run();
}
sub emit{
my ($s) = @_;
$s->emitParrot();
return unless $s->next();
$s->next()->emit();
}
sub runback{
my ($s) = @_;
$s->doStuff();
return unless $s->prev();
$s->prev()->runback();
}

sub suicide {
 my $s = shift;
 $s->prev->next($s->next);
 $s->next->prev($s->prev);
}

sub brule {
  my ($s, $pattern, $effect) = @_;
  return unless $s->prev();
  return unless $s->next();
  if (($s->is eq $pattern->[1]) || ($pattern->[1] eq "ANY")) {
   if (($s->prev->is eq $pattern->[0]) || ($pattern->[0] eq "ANY")) {
    if(($s->next->is eq $pattern->[2]) || ($pattern->[2] eq "ANY")) {
     $s->become($effect);}}}}
sub rule {
  my ($s, $pattern, $effect) = @_;
  return unless $s->prev();
  return unless $s->next();
  if (($s->is eq $pattern->[1]) || ($pattern->[1] eq "ANY")) {
   if (($s->prev->is eq $pattern->[0]) || ($pattern->[0] eq "ANY")) {
    if(($s->next->is eq $pattern->[2]) || ($pattern->[2] eq "ANY")) {
     $effect->();}}}}


package Node;
use base "LinkList";
use Data::Dumper;
$Data::Dumper::Maxdepth=1;

sub new {
my $o = bless {};
return $o;
}


sub dump {
my ($s) = @_;
#print Dumper $s;
print "[".$s->{pheno}."(".$s->{origin}->{content}.$s->{subtype}. ")] ";
if ($s->next){$s->next->dump();}
}


sub addarg {
my ($s, $arg) = @_;
$s->{arglist} ||= [];
push @{$s->{arglist}}, $arg;
}


sub engulfnext {
my ($s) = @_;
$s->next($s->next->next);
$s->next->prev($s);
}


sub engulfprev {
my $s = shift;
$s->prev($s->prev->prev());
$s->prev->next($s);
}

sub doStuff{
my $s = shift;
$s->rule( ["VARIABLETOBEASSIGNED", "ASSIGNMENT", "EXPRESSION"],
sub {$s->{subtype} = $s->is;$s->become("STATEMENT");
$s->{value} = $s->next;$s->engulfnext; $s->{target} = $s->prev;$s->engulfprev;});
$s->rule( [ "ANY", "ARGNAME", "EXPRESSION" ], sub {$s->become("ARG");$s->{value} = $s->next;$s->engulfnext;} );
if(($s->is eq "RETURN")
&& ($s->next->is eq "EXPRESSION"))
{$s->{subtype} = $s->is;$s->become("STATEMENT");$s->{value} = $s->next;$s->engulfnext;}
$s->brule( [ "ARGNAME", "VARIABLENAME",     "TERMINATOR" ] => "EXPRESSION");
$s->brule( [ "RETURN", "VARIABLENAME",     "TERMINATOR" ] => "EXPRESSION");
$s->brule( [ "ASSIGNMENT", "VARIABLENAME",     "TERMINATOR" ] => "EXPRESSION");
$s->brule( [ "ARGNAME", "VARIABLENAME",     "ENDANON" ]    => "EXPRESSION");
$s->brule( [ "STARTANON", "VARIABLENAME",     "ENDANON" ]    => "EXPRESSION");
$s->brule( [ "ARGNAME", "VARIABLENAME",     "ARGNAME" ],   => "EXPRESSION");
$s->brule( [ "ARGNAME", "VARIABLENAME",     "METHODSIG" ],   => "EXPRESSION");
$s->brule( [ "ARGNAME", "PROTO-EXPRESSION", "TERMINATOR" ] => "EXPRESSION");
$s->brule( [ "RETURN", "PROTO-EXPRESSION", "TERMINATOR" ] => "EXPRESSION");
$s->brule( [ "ARGNAME", "PROTO-EXPRESSION", "ENDANON" ] => "EXPRESSION");
$s->brule( [ "ARGNAME", "PROTO-EXPRESSION", "ARGNAME" ]    => "EXPRESSION");
$s->rule ( [ "ANY",     "PROTO-EXPRESSION", "ARG" ], sub  { $s->addarg($s->next);$s->engulfnext;});
$s->rule ( [ "ARG",     "METHODSIG", "ANY" ], sub  { $s->addarg($s->prev);$s->engulfprev;});
$s->rule ( [ "VARIABLENAME",     "METHODSIG", "ANY" ], sub  { $s->addarg($s->prev);$s->engulfprev;});
$s->brule( [ "ANY",     "OBJECT",           "ANY" ]        => "PROTO-EXPRESSION");
$s->brule( [ "ASSIGNMENT", "PROTO-EXPRESSION", "TERMINATOR" ] => "EXPRESSION");
$s->brule( [ "TERMINATOR", "PROTO-EXPRESSION", "TERMINATOR" ] => "EXPRESSION");
$s->brule( [ "TERMINATOR", "EXPRESSION",       "TERMINATOR" ] => "STATEMENT");
$s->brule( [ "TERMINATOR", "EXPRESSION",       "END" ] => "STATEMENT");
$s->brule( [ "START", "EXPRESSION",       "TERMINATOR" ] => "STATEMENT");
$s->brule( [ "STARTANON",  "PROTO-EXPRESSION", "ENDANON" ]    => "EXPRESSION");
if((($s->is eq "VARIABLENAME")||($s->is eq "PROTO-EXPRESSION")) && ($s->next->is eq "NOARGSCALL"))
 { $s->{subtype} = "UNARYCALL"; $s->{method} = $s->next; $s->engulfnext; $s->become("EXPRESSION")}
if($s->is eq "NUMBER") { $s->{object} = $s->{content}; $s->{subtype} = $s->is; $s->become("OBJECT")}
if($s->is eq "STRING") { $s->{object} = $s->{content}; $s->{subtype} = $s->is; $s->become("OBJECT")}
$s->rule ( [ "ANY", "VARIABLENAME",  "ARG" ], sub {$s->{subtype} = "MULTIARGCALL";$s->{object} = $s; $s->become("PROTO-EXPRESSION")});
$s->rule ( [ "ANONPARAMNAME", "ANONPARAMLIST", "ANY" ], sub  { shift @{$s->{paramlist}}, $s->prev;$s->engulfprev;});
if (($s->is eq "STARTANON") && ($s->next->is eq "ANONPARAMLIST")) { $s->{paramlist} = $s->next;$s->engulfnext;}
$s->rule ( [ "STARTANON", "EXPRESSION", "ANY" ], sub { $s->prev->addarg($s);$s->prev->engulfnext;});
$s->rule ( [ "STARTANON", "STATEMENT",  "ANY" ], sub { $s->prev->addarg($s);$s->prev->engulfnext;});
$s->rule ( [ "ANY", "STARTANON", "ENDANON" ],    sub { $s->{subtype} = "ANON";$s->engulfnext;$s->become("EXPRESSION");});
$s->rule ( [ "STARTANON", "TERMINATOR", "ANY" ],    sub { $s->suicide;});
}


sub calcMethodCallSig {
 my $s = shift;
my $sig = "";
foreach my $arg ( @{$s->{arglist}})
{$sig .= $arg->{origin}->{content}}
return $sig;
} 

sub calcMethodSig {
 my $s = shift;
my $sig = "";
foreach my $arg ( @{$s->{arglist}})
{$sig .= $arg->{origin}->{content}}
return $sig;
} 

sub exeMethodArgs {
 my $s = shift;
my $context = shift;
my @args=();
foreach my $arg ( @{$s->{arglist}})
{
#$arg->hashdump;
my $val = $arg->{value}->exe($context);
if (!$val||!$val->{PROXY}) { die "Method arg is not an object\n";}
push @args,  $val;
}
return \@args;
} 

sub emitParrotMethodArgs {
 my $s = shift;
my $sig = "";
my @arglist = ();
foreach my $arg ( @{$s->{arglist}})
{ 
print "# ". $arg->{origin}->{content} . "\n";
$arg->{value}->emitParrot;
push @arglist, "\$P".($s->sequence-1);
#print "Store \$P",$s->sequence-1," in ".$arg->{origin}->{content}, "\n";
}
return @arglist;
} 

sub send {
&::send(@_);
}

sub lookUp { 
my $s = shift;
my $name = shift;
my $context = shift;
#print "Looking up ".Dumper($name)."\n";
if ($name->is eq "STRING")
  { 
	my $o = new String($name->{content});
	return $o;
}
if ($name->is eq "NUMBER")
  { 
	&::trace("Looking up Number ".$name->{content}."\n");
	my $o = new Number( $name->{content});
	return $o;
}
if ($name->is eq "VARIABLENAME")
  { 
	my $n = $name->{content};
	&::trace("Looking up $n\n");
	my $obj =  $context->{variables}->{$n};
	unless ($obj) 
		{ if ($context->{parentContext}) 
{#print  "Failed to look up ".$name->{content}." in ".Dumper($context)."\n";
			$obj = $s->lookUp($name, $context->{parentContext});}}
	unless ($obj)
	  { $obj = $::Proto->{$name->{content}}; }
$obj || die "Failed to look up ".$name->{content}." in ".Dumper($context)."\n";
	&::trace("$n is $obj\n");
	return $obj;

}

die "Failed to look up ".$name->{content}."\n";
 }

sub translate_args {
my ($s, $context) = @_;
my $i = 0;
foreach my $arg ( @{$context->{args}})
 {
   my $target_a = @{$s->{arglist}}[$i];
   my $target = $target_a->{value}->{content};
   ##print "Setting arg name: $target to $arg\n";
   $context->{variables}->{$target} = $arg;
}
}

sub exe {
my $s = shift;
my $context = shift;
&::trace( "\nExeing ".$s->is."(".$s->{subtype}.")".$s->{content}."\n");
#print Dumper($context);
#$s->hashdump;
if ($s->is eq "END") {exit;}
if ($s->is eq "DECLAREVARIABLE")
{
  #print "Declaring variable ".$s->{origin}->{content}."\n";
}
if ($s->is eq "METHODSIG")
{
  #print "In method ".$s->calcMethodSig."\n";
  if ($context->{execnow}) { 
	$context->{execnow} = 0;
	#print "Running method\n";
	$context->{args} = \@_;
	$s->translate_args($context);
	return $s->next->exe($context);}
  else
	{
my $meth = $s->calcMethodSig;
$meth=~s/:/_COLON_/g;
#print "Registering ".$meth."\n";
$::Proto->{Current}->{realobject}->object->{realobject}->{vtable}->{$meth} = 
sub {$s->exe({execnow=>1, parentContext=>$context},@_);};
#print "Skipping...\n";
$s->skipToReturn($context);return;}
}
if ($s->is eq "EXPRESSION")
  { 
    if ($s->{subtype} eq "ANON")
      {
  if ($context->{execnow}) { 
	$context->{execnow} = 0;
	#print "Running anonblock\n";
	#$s->{value}->hashdump;
	my $ret;
	my $arglist = $s->{arglist};
	my @arglist = @{$arglist};
	$arglist[-1]->{pheno} = "EXPRESSION";
	$ret = $arglist[0]->exe($context);
	#foreach my $expr ( @arglist )
	  #{
#print "In anonblock, execing: ".$expr->is."\n";
 #$ret  = $expr->exe($context); }
	#print "Finished anon block, returned $ret\n";
	return $ret;}
else
{
        #print "Creating anonblock\n";
        my $block = new AnonBlock($s, $context);
        return $block;}}
    if ($s->{subtype} eq "VARIABLENAME")
      { 
	return $s->lookUp($s->{origin}, $context)}
    if ($s->{subtype} eq "UNARYCALL")
      { 
	my $obj =  $s->lookUp($s->{origin}, $context);
	return $s->send($obj, $s->{method}->{content});
}
    if ($s->{subtype} eq "NUMBER")
      { 
	&::trace("Creating new number\n");
	my $o = new Number( $s->{content});
	return $o;
}
    if ($s->{subtype} eq "STRING")
      { 
	#print "Creating new string\n";
	my $o = new String( $s->{content});
	return $o;
}
    if($s->{subtype} eq "MULTIARGCALL"){
	my $obj = $s->lookUp($s->{object}->{origin}, $context);
	return $s->send($obj, $s->calcMethodCallSig, @{$s->exeMethodArgs($context)});
}
}
if ($s->is eq "STATEMENT")
  { 
	if($s->{subtype} eq "RETURN"){
	#print "Starting return for ".$s->{value}."\n";
	my $ret = $s->{value}->exe($context);
	#print "Returning ".Dumper($ret)."\n";
	return $ret;
}
    if ($s->{subtype} eq "ASSIGNMENT")
      { 
        #print "Calculating value:\n";
	my $val = $s->{value}->exe($context);
	#print "Assigning to ".$s->{target}->{content}."\n";
	$context->{variables}->{$s->{target}->{content}} = $val;
    

}
    if ($s->{subtype} eq "UNARYCALL")
      { 
	my $obj =  $s->lookUp($s->{origin}, $context);
	$s->send($obj, $s->{method}->{content})
}

     if($s->{subtype} eq "MULTIARGCALL"){
	#print "Doing multiargcall\n";
	my $obj = $s->lookUp($s->{object}->{origin}, $context);
	$s->send($obj, $s->calcMethodCallSig, @{$s->exeMethodArgs($context)});
}
}

if( $s->next) { return $s->next->exe($context);}
print "Fell off end of run loop\n";

}

sub skipToReturn {
my $s = shift;
my $context = shift;
if ($s->{subtype} eq "RETURN") { $s->next->next->exe($context)}
else
  {if( $s->next) { $s->next->skipToReturn($context);}}
}

sub emitParrot {
my $s = shift;
#print "Processing: ", $s->hashdump, "\n";
if ($s->is eq "START") { print "#Entering routine...\n";}
if ($s->is eq "EXPRESSION")
  {
	#print "Calculate ".$s->{subtype}." and store in \$P".$s->sequence."\n";
if ($s->{subtype} eq "NUMBER") { print "\$P", $s->sequence, " = ", $s->{origin}->{content}, "\n";}
if ($s->{subtype} eq "STRING") { print "\$P", $s->sequence, " = ", $s->{origin}->{content}, "\n";}
	if($s->{subtype} eq "MULTIARGCALL"){
	my @arglist = $s->emitParrotMethodArgs;
	print "\$P".$s->sequence." = lookUp('".$s->{object}->{origin}."')\n";
	my $lastseq = $s->sequence-1;
	print "\$P".$s->sequence." = \$P".($lastseq).".'".$s->calcMethodCallSig. "'(".join(",", @arglist). ")\n";
}
	if($s->{subtype} eq "UNARYCALL"){
	print "\$P".$s->sequence." = lookUp('".$s->{origin}."')\n";
	my $lastseq = $s->sequence-1;
	print "\$P".$s->sequence." = \$P".($lastseq).".'".$s->{method}->{origin}->{content}."'()\n";}
	if($s->{subtype} eq "VARIABLENAME"){
	print "#VARIBALENAME ".$s->{origin}->{content}."\n";
	print "\$P".$s->sequence." = lookUp('".$s->{origin}."')\n";
}
}
if ($s->is eq "STATEMENT")
  {
	print "#Start ".$s->{subtype}." statement\n";
	if($s->{subtype} eq "UNARYCALL") {
	print "\$P".$s->sequence." = lookUp('".$s->{origin}."')\n";
	print "\$P".($s->sequence-1).".'".$s->{method}->{origin}->{content}."'()\n";}
	if($s->{subtype} eq "RETURN"){
	$s->{value}->emitParrot."\n";
	print ".return(\$P".($s->sequence-1).")\n"; 
}
	if($s->{subtype} eq "ASSIGNMENT"){
	$s->{value}->emitParrot."\n";
	print "store('".$s->{target}->{origin}->{content}."', \$P".($s->sequence-1).")\n"; 
}
	if($s->{subtype} eq "MULTIARGCALL"){
	my @arglist = $s->emitParrotMethodArgs;
	print "\$P".$s->sequence." = lookUp('".$s->{object}->{origin}."')\n";
	my $lastseq = $s->sequence-1;
	print "\$P".($lastseq).".'".$s->calcMethodCallSig. "'(".join(",", @arglist). ")\n";

}


}}


























package Cell;
use base "LinkList";
use Data::Dumper;
sub new {
my $o = bless {};
return $o;
}

sub  eatArray {
my ($s) = @_;
my $c = new Neo;
$c->input($s->input());
$c->prev($s);
$s->next($c);
$c->eat();
if (scalar(@{$s->{input}})){return $c->eatArray();}
else{
my $e = new Neo;
$e->prev($e);
$e->next(undef);
$c->next($e);
return $c}
}
sub become {
my ($s, $new) = @_;
$s->{pheno} = $new;
bless $s, $new;
}



sub input {
my ($s, $val) = @_;
if ($val) { $s->{input} = $val;}
return $s->{input};
}

sub eat {
my ($s) = @_;
my $in = $s->{input};
$s->{content} = shift @{$in};
$s->setpheno();
}
sub dump {
my ($s) = @_;
print "[".$s->pheno.":".$s->{content}, "] ";
#print "[".$s->pheno.":".$s->{content}, "] ";
#print "[".$s->{content}, "]-";
if ($s->next()){$s->next()->dump();}
}

sub setpheno {
my ($s) = @_;
my $c = $s->{content};
$s->{pheno} = $c;
if ($c =~ /^[a-zA-Z0-9]+$/) {$s->become( "ALPHANUM")}
if ($c =~ /^[0-9]+$/) {$s->become(  "NUMBER")}
if ($c =~ /^\s+$/) {$s->become( "WHITESPACE")}
if ($c =~ /\r|\n/) {$s->become(  "NEWLINE")}
if ($c eq "'") {$s->become( "STRINGTERM")}
if ($c eq '"') {$s->become( "QUOTETERM")}
if ($c eq '#') {$s->become( "LINECOMMENT")}
if ($c eq ':') {$s->become( "COLON")}
if ($c eq '.') {$s->become("TERMINATOR")}
if ($c eq '[') {$s->become( "STARTANON")}
if ($c eq ']') {$s->become( "ENDANON")}
if ($c eq '|') {$s->become( "VBAR")}
if ($c eq '^') {$s->become( "RETURN")}
return $c;
}



sub isNum {
my ($s) = @_;
if ($s->{content} =~ /^[0-9]+$/) {return 1;} else {return 0;}
}

sub incorporatenext{
my ($s)=@_;
my $t= $s->next->is;
$s->{organelles}->{$t} = $s->next;
$s->next($s->next->next);
$s->next->prev($s);
}
sub makenodes {
  my $s = shift;
#print "Making node for ".$s->pheno."\n";
  my $n = new Node;
  $n->{origin} = $s;
  $n->{content} = $s->{content};
  $n->{pheno} = $s->pheno;
  #$n->{first} = $s;
  #$n->{last} = $s;
  if($s->prev){
$n->{prev} = $s->prev->{parent};
$n->{prev}->{next} = $n; 
}
  $s->{parent} = $n;
#print "Done making node for ".$s->pheno."\n";
  unless($s->is eq "END"){return $s->next->makenodes ;}
  return $n;
}

sub a {}
sub b{}

sub doStuff {
my ($s) = @_;
if($s->is eq "WHITESPACE") { $s->suicide;}
if($s->is eq "NEWLINE") { $s->suicide;}
if($s->is eq "QUOTE") { $s->suicide;}
return unless $s->prev();
return unless $s->next();


$s->b;
#print "Comparing ".$s->{content}." with ". $s->next->is."\n";
}

sub engulfnext {
my ($s) = @_;
$s->{content} = $s->{content} . $s->next->{content};
$s->next($s->next->next);
$s->next->prev($s);
}


sub engulfprev {
my $s = shift;
$s->{content} = $s->prev->{content} . $s->{content};
$s->prev($s->prev->prev());
$s->prev->next($s);
}
sub mergewithprev {
my ($s, $target) = @_;
$s->{content} = $target->{content} . $s->{content};
$s->prev($target->prev());
$s->prev()->next($s);
}



package START; use base "Cell";
package VARIABLENAME; use base "Cell";
sub b {my $s = shift;
$s->brule ( [ "ANY", "VARIABLENAME", "ASSIGNMENT" ] => "VARIABLETOBEASSIGNED");
$s->brule ( [ "ANY", "VARIABLENAME", "DECLAREVARIABLE" ] => "DECLAREVARIABLE");}

package COLON; use base "Cell";
sub b {
  my $s = shift;

   if (($s->prev->is eq "ALPHANUM")||($s->prev->is eq "IDENTIFIER"))
    { $s->become("ARGNAME");
      $s->engulfprev();}

   if (($s->next->pheno eq "ALPHANUM")||($s->next->pheno eq "IDENTIFIER"))
    { $s->become("ANONPARAMNAME");
      $s->engulfnext();}
}

package ALPHANUM; use base "Cell";
sub b {my $s = shift;
if (($s->pheno ne $s->next->pheno)&& ($s->pheno ne $s->prev->pheno)) {$s->become( "IDENTIFIER")}}

package TERMINATOR; use base "Cell";
sub b { 
my $s = shift;
$s->rule ( [ "NUMBER", "TERMINATOR", "NUMBER" ] => sub {$s->engulfnext;$s->prev->engulfnext; } );
}

package ARGNAME; use base "Cell";
sub b{
my $s = shift;
#if ($s->prev->is eq "IDENTIFIER") { $s->engulfprev}
#if ($s->next->is ne "ARGNAME") {$s->incorporatenext} 
}

package IDENTIFIER; use base "Cell";
sub b {
my $s = shift;
$s->brule ( [ "ASSIGNMENT",    "IDENTIFIER", "ANY" ] => "VARIABLENAME");
$s->brule ( [ "RETURN",        "IDENTIFIER", "ANY" ] => "VARIABLENAME");
$s->brule ( [ "ANONPARAMLIST", "IDENTIFIER", "ANY" ] => "VARIABLENAME");
$s->brule ( [ "ARGNAME",       "IDENTIFIER", "ANY" ] => "VARIABLENAME");
$s->brule ( [ "VBAR",          "IDENTIFIER", "VBAR" ] => "DECLAREVARIABLE");
$s->brule ( [ "VBAR",          "IDENTIFIER", "ANY" ] => "VARIABLENAME");
$s->brule ( [ "DECLAREVARIABLE","IDENTIFIER", "ANY" ] => "VARIABLENAME");
$s->brule ( [ "VARIABLENAME",  "IDENTIFIER", "ANY" ] => "NOARGSCALL");
$s->brule ( [ "NUMBER",        "IDENTIFIER", "ANY" ] => "NOARGSCALL");
$s->brule ( [ "STRING",        "IDENTIFIER", "ANY" ] => "NOARGSCALL");
$s->brule ( [ "IDENTIFIER", "IDENTIFIER", "TERMINAL" ], => "NOARGSCALL");
$s->brule ( [ "IDENTIFIER", "IDENTIFIER", "ARGNAME" ]=> "NOARGSCALL" );
$s->brule ( [ "TERMINATOR", "IDENTIFIER", "ANY" ]    =>     "VARIABLENAME");
$s->brule ( [ "STARTANON", "IDENTIFIER", "ANY" ]    =>     "VARIABLENAME");
$s->rule  ( [ "ANY", "IDENTIFIER", "VBAR" ], sub { $s->become("DECLAREVARIABLE");$s->runback;$s->next->suicide});
$s->brule ( [ "ANY", "IDENTIFIER", "DECLAREVARIABLE" ] =>"DECLAREVARIABLE"); 
#$s->rule  ( [ "ANY", "IDENTIFIER", "METHODSIG" ], sub { $s->become("DECLAREVARIABLE");$s->runback;});

}

package WHITESPACE; use base "Cell";
package NEWLINE; use base "Cell";
package NUMBER; use base "Cell";
package STRINGTERM; use base "Cell";
package NOARGSCALL; use base "Cell";
sub b { my $s = shift; $s->brule ( [ "ANY", "NOARGSCALL", "DECLAREVARIABLE" ] => "DECLAREVARIABLE");}
package STARTANON; use base "Cell";
package ENDANON; use base "Cell";
package QUOTETERM; use base "Cell";
package END; use base "Cell";
package ASSIGNMENT; use base "Cell";
package STRING; use base "Cell";
package ANONPARAMNAME; use base "Cell";
package QUOTE; use base "Cell";
package DECLAREVARIABLE; use base "Cell";
package VARIABLETOBEASSIGNED; use base "Cell";
package RETURN; use base "Cell";
package METHODSIG; use base "Cell";
package VBAR; use base "Cell";
sub b {
my $s = shift;
$s->brule ( [ "ANONPARAMNAME", "VBAR", "ANY" ] => "ANONPARAMLIST");
$s->brule ( [ "ANY", "VBAR", "DECLAREVARIABLE" ] =>"METHODSIG"); 
$s->brule ( [ "ANY", "VBAR", "VBAR" ] =>"METHODSIG"); 
}
package ANONPARAMLIST; use base "Cell";

package Neo;use base "Cell";

sub doStuff{
my $s = shift;
return unless $s->prev();
return unless $s->next();
$s->rule ( [ "ANY", "ANY", "=" ], sub {$s->engulfnext;$s->become("ASSIGNMENT");} );
$s->rule ( [ "ANY", "STRINGTERM", "ANY" ], sub { $s->become("OPENSTRING");$s->{content}=""} );
if($s->is eq "OPENSTRING"){
if ($s->next->is eq "STRINGTERM"){$s->engulfnext;$s->become("STRING");}
else {$s->engulfnext;$s->doStuff;}}

if ($s->is eq "QUOTETERM"){ $s->become("OPENQUOTE");$s->{content}=""} 
if($s->is eq "OPENQUOTE"){
if ($s->next->is eq "QUOTETERM"){$s->engulfnext;$s->become("QUOTE");}
else {$s->engulfnext;$s->doStuff;}}

if ($s->is eq $s->next()->is) { $s->engulfnext}
if ($s->is eq $s->prev()->is) { $s->engulfprev}
$s->rule  ( [ "ANY", "ALPHANUM", "NUMBER" ], sub { $s->engulfnext;});
}

sub evolve {
my $s = shift;
#print "Making node for ".$s->pheno."\n";
  my $n = new Cell;
  $n->{origin} = $s;
  $n->{content} = $s->{content};
  $n->become($s->pheno);
  $n->{first} = $s;
  $n->{last} = $s;
  if($s->prev){
$n->{prev} = $s->prev->{parent};
$n->{prev}->{next} = $n; 
}
  $s->{parent} = $n;
#print "Done making node for ".$s->pheno."\n";
  unless($s->is eq "END"){return $s->next->evolve ;}
  return $n;

}
sub become {
my ($s, $new) = @_;
$s->{pheno} = $new;
}

sub new {
my $o = bless {};
$o->{scents} = {};
return $o;
}
